home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmisc2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-08  |  8.0 KB  |  247 lines
  1. (*===========================================================================*)
  2. (* Miscellaneous things - 2                                                  *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989, 1990, 1991, 1992 by H. Roy Engehausen.  All       *)
  5. (*   rights reserved.                                                        *)
  6. (*                                                                           *)
  7. (*===========================================================================*)
  8.  
  9. {$O+}
  10.  
  11. UNIT BBMISC2;
  12.  
  13. INTERFACE
  14.  
  15. USES
  16.   bbdummy;
  17.  
  18. PROCEDURE send_msg_header (type_head : INTEGER);
  19. PROCEDURE cannot_do_this  (mess_number : BYTE);
  20.  
  21. PROCEDURE msg_action_check(this_msg            : msg_index_ptr;
  22.                            VAR last_msg_action : action_msg_ptr);
  23.  
  24. FUNCTION  bbs_busy                             : BOOLEAN;
  25. FUNCTION  get_option_string(VAR in_s : STRING) : str15;
  26. FUNCTION  find_mail(mail_type : CHAR)          : BOOLEAN;
  27.  
  28. IMPLEMENTATION
  29.  
  30. USES
  31.   bbmdata,
  32.   bbmess,
  33.   bbmf,
  34.   bbsearch,
  35.   bbstr,
  36.   bbtrace;
  37.  
  38. {$UNDEF DEBUG_ACT}
  39.  
  40. (*===========================================================================*)
  41. (* Send the message header                                                   *)
  42. (*===========================================================================*)
  43.  
  44. PROCEDURE send_msg_header(type_head : INTEGER);
  45.  
  46.   BEGIN;
  47.  
  48.     IF type_head < 0 THEN
  49.       type_head := active_tcb^.uid_data.user_fmt;
  50.  
  51.     CASE type_head OF
  52.       1: send_message(message_msg_head1);
  53.       2: send_message(message_msg_head2);
  54.       3: send_message(message_msg_head3);
  55.       4: send_message(message_msg_head4);
  56.       ELSE
  57.          send_message(message_msg_head0);
  58.     END;
  59.  
  60.   END;
  61.  
  62. (*===========================================================================*)
  63. (* Routine called if something is busy so we can't do anything               *)
  64. (*===========================================================================*)
  65.  
  66. PROCEDURE cannot_do_this(mess_number : BYTE);
  67.  
  68.   BEGIN;
  69.  
  70.     send_message(mess_number);
  71.  
  72.     IF active_tcb^.tcb_type <> th_fwd_control THEN EXIT;
  73.  
  74.     wakeup_did_something := FALSE;
  75.  
  76.   END;
  77.  
  78. (*===========================================================================*)
  79. (* Routine called to see if a message is on the action list                  *)
  80. (*===========================================================================*)
  81.  
  82. PROCEDURE msg_action_check(this_msg : msg_index_ptr;
  83.                            VAR last_msg_action : action_msg_ptr);
  84.  
  85.   VAR
  86.     b                : BOOLEAN;
  87.     local_msg_action : action_msg_ptr;
  88.  
  89.   BEGIN;
  90.  
  91.     IF last_msg_action = NIL THEN
  92.       local_msg_action := first_msg_action
  93.     ELSE
  94.       local_msg_action := last_msg_action^.next_action;
  95.  
  96.     {$IFDEF DEBUG_ACT}
  97.       trace_data('MACheckS', local_msg_action^.action_type,
  98.                                       this_msg, local_msg_action^.action_info);
  99.     {$ENDIF}
  100.  
  101.     WHILE local_msg_action <> NIL DO
  102.       BEGIN;
  103.  
  104.         IF local_msg_action^.action_srch = NIL THEN
  105.           b := search_test(local_msg_action^.action_info, this_msg)
  106.         ELSE
  107.           b := search_test_block(local_msg_action^.action_srch, this_msg);
  108.  
  109.         IF b THEN
  110.           BEGIN;
  111.             last_msg_action := local_msg_action;
  112.             EXIT;
  113.           END;
  114.  
  115.         local_msg_action := local_msg_action^.next_action;
  116.  
  117.         {$IFDEF DEBUG_ACT}
  118.           trace_data('MACheckL', local_msg_action^.action_type,
  119.                                       this_msg, local_msg_action^.action_info);
  120.         {$ENDIF}
  121.  
  122.       END;
  123.  
  124.     {$IFDEF DEBUG_ACT}
  125.       trace_data('MACheckE', local_msg_action^.action_type,
  126.                                       this_msg, local_msg_action^.action_info);
  127.     {$ENDIF}
  128.  
  129.     last_msg_action := NIL;
  130.  
  131.   END;
  132.  
  133. (*===========================================================================*)
  134. (* See if anyone else is on..                                                *)
  135. (*===========================================================================*)
  136.  
  137. FUNCTION bbs_busy : BOOLEAN;
  138.  
  139.   BEGIN;
  140.  
  141.     (*-----------------------------------------------------------------------*)
  142.     (* Assume we are failing                                                 *)
  143.     (*-----------------------------------------------------------------------*)
  144.  
  145.     bbs_busy := TRUE;
  146.  
  147.     (*-----------------------------------------------------------------------*)
  148.     (* Fail if forwarding is busy                                            *)
  149.     (*-----------------------------------------------------------------------*)
  150.  
  151.     IF fwd_out_busy AND (active_tcb^.tcb_type <> th_fwd_control) THEN
  152.       EXIT;
  153.  
  154.     (*-----------------------------------------------------------------------*)
  155.     (* Fail if operator is busy                                              *)
  156.     (*-----------------------------------------------------------------------*)
  157.  
  158.     IF op_busy AND (active_tcb^.tcb_type <> th_operator) THEN
  159.       EXIT;
  160.  
  161.     (*-----------------------------------------------------------------------*)
  162.     (* Fail if local operator or WAKEUP and someone else is on               *)
  163.     (*-----------------------------------------------------------------------*)
  164.  
  165.     IF (active_tcb^.tcb_type <= th_fwd_control)
  166.                               AND (alive_tcb_count <> overhead_tcb_count) THEN
  167.       EXIT;
  168.  
  169.     (*-----------------------------------------------------------------------*)
  170.     (* Fail if remote SYSOP and anyone else is on                            *)
  171.     (*-----------------------------------------------------------------------*)
  172.  
  173.     IF (active_tcb^.tcb_number > overhead_tcb_count)
  174.                         AND (alive_tcb_count <> (overhead_tcb_count + 1)) THEN
  175.       EXIT;
  176.  
  177.     (*-----------------------------------------------------------------------*)
  178.     (* Everything else works                                                 *)
  179.     (*-----------------------------------------------------------------------*)
  180.  
  181.     bbs_busy := FALSE;
  182.  
  183.   END;
  184.  
  185. (*===========================================================================*)
  186. (* Get the option block from a string and remove the block                   *)
  187. (*===========================================================================*)
  188.  
  189. FUNCTION get_option_string(VAR in_s : STRING) : str15;
  190.  
  191.   VAR
  192.     i     : BYTE;
  193.     out_s : str15;
  194.  
  195.   BEGIN;
  196.  
  197.     out_s := subword(@in_s, 2, 1);
  198.  
  199.     IF (LENGTH(out_s) = 0)
  200.                            OR (out_s[1] <> '[')
  201.                            OR (out_s[LENGTH(out_s)] <> ']') THEN
  202.       BEGIN;
  203.         get_option_string := '';
  204.         EXIT;
  205.       END;
  206.  
  207.    get_option_string := out_s;
  208.  
  209.    in_s := SUBWORD(@in_s, 1, 1) + ' ' + SUBWORD(@in_s, 3, 0);
  210.  
  211.  END;
  212.  
  213. (*===========================================================================*)
  214. (* This checks to see if there is a certain type of mail                     *)
  215. (*===========================================================================*)
  216.  
  217. FUNCTION find_mail(mail_type : CHAR) : BOOLEAN;
  218.  
  219.   VAR
  220.     search_block : search_block_type;
  221.  
  222.   BEGIN;
  223.  
  224.     (*-----------------------------------------------------------------------*)
  225.     (* Set up for search                                                     *)
  226.     (*-----------------------------------------------------------------------*)
  227.  
  228.     FILLCHAR(search_block, SIZEOF(search_block), #0);
  229.  
  230.  
  231.     search_block.search_ascend := TRUE;
  232.     search_block.search_type   := mail_type;
  233.     search_block.search_str    := active_tcb^.uid_data.user_id;
  234.     search_block.search_last   := NIL;
  235.  
  236.     (*-----------------------------------------------------------------------*)
  237.     (* Search for the messages.                                              *)
  238.     (*-----------------------------------------------------------------------*)
  239.  
  240.     search_msg(@search_block);
  241.  
  242.     find_mail := search_block.search_last <> NIL;
  243.  
  244.   END;
  245.  
  246. END.
  247.